home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / HAM_RAD / PROPAGAT / 1004A.ZIP / MOON-JXN.BAS < prev    next >
BASIC Source File  |  1987-05-12  |  27KB  |  542 lines
  1. 100 'MOON.BAS
  2. 109 ' REVISED MAY 28,1986
  3. 110 '
  4. 120 'THIS PROGRAM WAS WRITTEN TO PROVIDE ACCURATE VISIBLE AZIMUTH AND ELEVATION
  5. 130 'COORDINATES FOR THE MOON AT ANY TIME AND DATE, FROM ANY LOCATION ON THE
  6. 140 'EARTH.  BECAUSE IT WAS WRITTEN PRIMARILY FOR AMATEUR RADIO OPERATORS WHO
  7. 150 'NEED MOON TRACKING DATA FOR EARTH-MOON-EARTH COMMUNICATIONS, SOME OF THE
  8. 155 'FEATURES AND PRINTOUT OPTIONS HAVE BEEN SPECIFICALLY DESIGNED TO PROVIDE
  9. 156 'INFORMATION THAT WOULD BE MOST USEFUL FOR THAT APPLICATION.
  10. 160 '
  11. 161 'SOME FEATURES OF THIS PROGRAM ARE:
  12. 162 '
  13. 163 '    1. PRINTOUT OF THE MONTH AND DAY OF THE WEEK IN ADDITION TO DATE
  14. 164 '    2. AUTOMATIC CALCULATION OF QTH LOCATOR CODE FROM INPUT COORDINATES
  15. 165 '    3. DAILY CALCULATION OF MOON DISTANCE AND SEMIDIAMETER FOR NOON GMT
  16. 166 '    4. DISPLAY OF NUMBER OF DAYS PAST APOGEE OR PERIGEE
  17. 167 '    5. GREENWICH HOUR ANGLE,RIGHT ASCENSION AND DECLINATION DISPLAYED
  18. 168 '    6. BACKGROUND SKY NOISE IS ESTIMATED FOR BOTH 144 AND 432 MHZ
  19. 169 '    7. "DB SENSITIVITY INDICES" (TAKING SKY NOISE AND MOON DISTANCE INTO
  20. 170 '       ACCOUNT) ARE CALCULATED FOR 144 AND 432 MHZ
  21. 171 '    8. CALCULATION OF MOON ACTIVITY "WINDOW", WITH DEFINITIONS AUTOMATI-
  22. 172 '       CALLY CHOSEN, DEPENDING ON YOUR (APPROXIMATE) IARU REGION.
  23. 173 '    9. A WARNING NOTE ("NM") DURING NEW MOON, AND PRINTOUT OF SOLAR
  24. 174 '       AZIMUTH AND ELEVATION INSTEAD OF SKY NOISE DURING THIS PERIOD
  25. 175 '   10. AUTOMATIC SKIP TO NEXT MOONRISE OR MOON WINDOW UPON MOONSET OR MOVE
  26. 176 '       OUT OF A SPECIFIED WINDOW (SUCH AS ONLY NEAR THE HORIZON), TO
  27. 177 '       INCREASE PROGRAM SPEED
  28. 178 '   11. AUTOMATIC DAY ADVANCE; YOU ONLY ENTER BEGINNING AND ENDING DATES
  29. 179 '
  30. 180 'SOME OF THE OPTIONS AVAILABLE AT RUN TIME ARE:
  31. 181 '
  32. 182 '    1. DEFAULT TO YOUR STATION ON A BLANK ENTRY FOR CALLSIGN
  33. 183 '    2. DEFAULT TO YOUR LOCATION ON YOUR CALLSIGN OR A BLANK CALLSIGN ENTRY
  34. 184 '    3. SELECTION OF HORIZON-ONLY PRINTOUT
  35. 185 '    4. SKIP ALL SUBSEQUENT INPUT OPTIONS BY ENTERING A BLANK AT CALLSIGN
  36. 186 '       OR "HORIZON ONLY?" PROMPTS
  37. 188 '    5. SPECIFY DIFFERENT ACTIVITY WINDOW REGION DEFINITIONS THAN NORMAL
  38. 197 '    6. SELECTION OF PRINTOUT ONLY DURING THE ACTIVITY WINDOWS, NORTH
  39. 198 '       DECLINATION, CERTAIN HOURS, OR ON GMT WEEKENDS
  40. 199 '    7. SIMULTANEOUS CALCULATION OF THE MOON'S AZIMUTH AND ELEVATION AT
  41. 200 '       YOUR LOCATION ALONG WITH THE PRINTOUT FOR THE OTHER STATION
  42. 201 '    8. VARIABLE TIME INCREMENTS FOR PRINTOUT
  43. 202 '    9. NUMBER OF ESTIMATED CALCULATIONS TO BE DONE IN BETWEEN ACTUAL
  44. 203 '       CALCULATIONS, FOR INCREASE IN PROGRAM SPEED (ACTUAL CALCULATIONS
  45. 204 '       ARE INDICATED BY A DOT AFTER THE "WINDOW" COLUMN ON THE PRINTOUT)
  46. 205 '   10. ENTRY OF A LOCATOR (PRECEDED BY ANY NON-NUMERIC AND NON-ALPHABETIC
  47. 206 '       CHARACTER) IN PLACE OF A CALLSIGN PERMITS AUTOMATIC CALCULATION
  48. 207 '       OF COORDINATES FOR THAT LOCATION
  49. 210 '
  50. 220 'THE OUTPUT DATA SHOULD BE ACCURATE TO WITHIN .5 DEGREES PROVIDED THE
  51. 230 'PROCESSOR IS CAPABLE OF PERFORMING CALCULATIONS WITH 8 SIGNIFICANT
  52. 240 'DIGITS.  THIS VERSION WAS WRITTEN IN IBM PC BASIC SPECIFICALLY TO RUN ON
  53. 250 'AN IBM PC/AT, ALTHOUGH THE PROGRAM SHOULD BE COMPATIBLE WITH ANY OF THE
  54. 260 'IBM PC'S OR OTHER "PC COMPATIBLES" WITH FEW (IF ANY) CHANGES. IT SHOULD
  55. 261 'PROVIDE ACCURATE DATA WELL INTO THE 21ST CENTURY AND DOES NOT REQUIRE
  56. 262 'ANY DAILY, MONTHLY OR ANNUAL PROGRAM OR ORBITAL UPDATES.
  57. 270 '
  58. 280 'OTHER VERSIONS OF THE PROGRAM, INCLUDING ONES IN DEC FORTRAN IV AND
  59. 285 'IBM BASIC FOR SYSTEMS 23,34 AND 36 HAVE BEEN WTITTEN BY THE AUTHOR,
  60. 290 'ALTHOUGH THE CODE IN THIS PARTICULAR PROGRAM IS THE MOST UP TO DATE.
  61. 295 '
  62. 296 'THIS PROGRAM IS FREE FOR ANYONE'S USE, PROVIDED THESE INTRODUCTORY REMARKS
  63. 297 'REMAIN AND CREDIT IS GIVEN TO THE AUTHOR.
  64. 310 '
  65. 320 'LANCE COLLISTER   WA1JXN
  66. 330 'P.O. BOX 73
  67. 335 'FRENCHTOWN, MT
  68. 340 'USA      59834
  69. 345 '
  70. 350 'TEL: (406) 626-5728
  71. 352 '
  72. 353 '
  73. 360 '********************************************************************
  74. 362 LET TEMRA=60          'ENTER YOUR 144 MHZ RCVR TEMP HERE
  75. 363 LET TEMRB=80          'ENTER YOUR 432 MHZ RCVR TEMP HERE
  76. 366 LET NESTS=4 'ENTER DEFAULT NUMBER OF ESTIMATES BETWEEN ACTUAL CALCULATIONS
  77. 367 LET YCSIGN$="WA1JXN"  'ENTER YOUR CALLSIGN HERE
  78. 368 LET YLATDP=47.048333# 'ENTER YOUR LATITUDE IN DEGREES HERE
  79. 369 LET YLONDP=114.25556# 'ENTER YOUR LONGITUDE IN DEGREES HERE
  80. 370 '*********************************************************************
  81. 371 LET B1=0
  82. 372 LET E=2400
  83. 375 PI =3.141592656#
  84. 376 DIM H(51),RTEMA(51),RTEMB(51),WKDAY$(10)
  85. 377 LET TUPI =2*PI
  86. 378 LET RAD=TUPI/360
  87. 379 LET DEG=360/TUPI
  88. 380 DEF FNA(X)=INT(X*DEG*10+.5)/10
  89. 381 DEF FNB(X)=INT(X*100+.5)/100
  90. 382 DEF FNC(X)=(X-INT(X))*TUPI
  91. 383 DEF FNR(A,B)=INT(A*B+.5)/B
  92. 384 DEF FNL(X)=LOG(X)/LOG(10) 'COMMON LOGARITHM OF X
  93. 388 DEF FNJULIAN(AY,AM,AD)=367*AY-INT(7*(AY+INT((AM+9)/12))/4)+INT(275*AM/9)+AD-676534! 'JULIAN DATE (MINUS 2397547.5) FOR 0000 HOURS GMT, YEARS 1900-2099.
  94. 389 DEF FNATAN2(S,C)=ATN(S/C)-SGN(S)*PI*(FIX(SGN(C)-.5))
  95. 392 '**********************LOAD SKY TEMPERATURE DATA*********************
  96. 393 FOR I%=1 TO 50
  97. 394 READ H(I%),RTEMA(I%),RTEMB(I%) 'RIGHT ASCENSION,136MHZ ,400MHZ SKY TEMPS
  98. 396 LET RTEMA(I%)=RTEMA(I%)*.87 '144 MHZ SKY TEMP IN DEGREES KELVIN
  99. 398 LET RTEMB(I%)=RTEMB(I%)*.83 '432 MHZ SKY TEMP IN DEGREES KELVIN
  100. 400 NEXT I%
  101. 410 DATA 0,275,24,.5,300,24.5,1,320,25,1.5,340,25.5,2,350,27
  102. 420 DATA 2.5,400,29,3,425,30,3.5,400,28,4,425,30.5,4.5,460,34.5
  103. 430 DATA 5,500,37.5,5.5,575,45,6,575,44.5,6.5,475,37.5,7,425,32
  104. 440 DATA 7.5,350,25.5,8,260,19.5,8.5,230,17.5,9,200,15,9.5,210,15.5
  105. 450 DATA 10,215,16.5,10.5,225,17.5,11,235,18,11.5,245,19,12,300,22.5
  106. 460 DATA 12.5,360,27.5,13,360,27.5,13.5,350,25,14,375,27,14.5,415,30
  107. 470 DATA 15,450,32.5,15.5,480,35,16,550,39,16.5,700,45,17,1000,55
  108. 480 DATA 17.5,1850,110,18,3800,180,18.5,2400,160,19,1000,80,19.5,600,52
  109. 490 DATA 20,425,32,20.5,375,28.5,21,375,27.5,21.5,375,27.5,22,340,25
  110. 500 DATA 22.5,280,22,23,280,22.5,23.5,275,23,24,275,23.5,24.5,300,24.5
  111. 680 '*******************START OF DATA INPUT SECTION******************
  112. 690 CLS
  113. 700 INPUT "What is the CALLSIGN";CSIGN$
  114. 705 IF CSIGN$=YCSIGN$ OR CSIGN$="" THEN 711 ELSE 725
  115. 711 LET ULATDP=YLATDP    'DEFAULTS TO YOUR LATITUDE
  116. 712 LET ULONDP=YLONDP    'DEFAULTS TO YOUR LONGITUDE
  117. 713 IF CSIGN$=YCSIGN$ THEN 770 'GIVES YOU A CHANCE TO USE PROMPTS
  118. 714 LET CSIGN$=YCSIGN$ 'DEFAULTS TO YOUR CALL,SKIPS PROMPTS ON BLANK ENTRY
  119. 720 GOTO 1150
  120. 725 LET FIRST=ASC(LEFT$(CSIGN$,1))
  121. 726 IF FIRST>90 OR  FIRST<48 THEN 728
  122. 727 IF FIRST>57 AND FIRST<65 THEN 728 ELSE 760
  123. 728 LET LCALL=LEN(CSIGN$)
  124. 729 LET X=0
  125. 730 IF LCALL=7 THEN 740
  126. 732 IF LCALL=5 THEN 733 ELSE 736
  127. 733 LET CSIGN$=CSIGN$+"MM"
  128. 734 GOTO 742
  129. 736 IF LCALL=3 THEN LET CSIGN$=CSIGN$+"55MM" ELSE 700
  130. 737 GOTO 742
  131. 740 LET X=.5
  132. 742 LET CSIGN$=RIGHT$(CSIGN$,6)
  133. 745 LET ULONDP=180-(ASC(MID$(CSIGN$,1,1))-65)*20-(VAL(MID$(CSIGN$,3,1)))*2-((ASC(MID$(CSIGN$,5,1))-65)+X)/12 'LONGITUDE FROM LOCATOR
  134. 750 LET ULATDP=-90+(ASC(MID$(CSIGN$,2,1))-65)*10+VAL(MID$(CSIGN$,4,1))+((ASC(MID$(CSIGN$,6,1))-65)+X)/24     'LATITUDE FROM LOCATOR
  135. 755 GOTO 770
  136. 760 INPUT "What is the LATITUDE in DEG,MIN,SEC (+ for north)";ULATDP,ULATMP,ULATSP
  137. 765 INPUT "What is the LONGITUDE in DEG,MIN,SEC (+ for west)";ULONDP,ULONMP,ULONSP
  138. 770 INPUT "Do you only want printout near the horizon";ANS1$
  139. 780 IF ANS1$="" THEN 1150 'SKIP ALL THE PROMPTS ON A BLANK ENTRY TO THIS
  140. 790 IF ANS1$= "YES" THEN 800 ELSE 850
  141. 800 INPUT "Below what elevation in degrees do you want printout";BELEV
  142. 850 INPUT "Do you want printout only during north declination";ANS2$
  143. 860 INPUT "What moon activity window definition do you want (IARU Region #)";REGION
  144. 870 INPUT "Do you want printout only during European window";ANS3$
  145. 890 INPUT "Do you want printout only during N. American window";ANS4$
  146. 910 INPUT "Do you want printout only during the Asian window";ANS5$
  147. 970  INPUT "Do you only want printout on GMT weekends";ANS8$
  148. 975 INPUT  "Do you also want your own moon positions printed";ANS9$
  149. 980 INPUT "Do you want printout only between specific times";ANS6$
  150. 990 IF ANS6$="YES" THEN 1030  ELSE 1090
  151. 1030 INPUT "What are GMT beginning,ending times";B1,E
  152. 1090 INPUT "What is desired printout increment in minutes";DINC
  153. 1130 INPUT "How many estimated positions do you want between calcs";NEST$
  154. 1150 INPUT "What is beginning date (YY,MM,DD)";AY1,AM1,AD1
  155. 1210 INPUT "What is the ending date (YY,MM,DD)";EY,EM,ED
  156. 1220 '*********************END OF DATA INPUT SECTION******************
  157. 1225 LET ULATD=ULATDP+SGN(ULATDP)*ABS(ULATMP)/60+SGN(ULATDP)*ABS(ULATSP)/3600
  158. 1230 LET ULATDP=INT(ABS(ULATDP))
  159. 1231 LET ULATMP=INT((ABS(ULATD)-INT(ABS(ULATD)))*60)
  160. 1232 LET ULATSP=INT((((ABS(ULATD)-INT(ABS(ULATD)))*60)-ULATMP)*60+.5)
  161. 1233 LET ULOND=ULONDP+SGN(ULONDP)*ABS(ULONMP)/60+SGN(ULONDP)*ABS(ULONSP)/3600
  162. 1234 LET ULONDP=INT(ABS(ULONDP))
  163. 1235 LET ULONMP=INT((ABS(ULOND)-INT(ABS(ULOND)))*60)
  164. 1236 LET ULONSP=INT((((ABS(ULOND)-INT(ABS(ULOND)))*60)-ULONMP)*60+.5)
  165. 1237 IF ULOND>-80 AND ULOND=<40 AND REGION<1 THEN LET REGION=1
  166. 1238 IF ULOND>40 AND ULOND=<160 AND REGION<1 THEN LET REGION=2
  167. 1239 IF ULOND>160 OR ULOND<=-80 AND REGION<1 THEN LET REGION=3
  168. 1240 GOSUB 3080
  169. 1241 LET ULATD=ULATD*RAD
  170. 1242 LET YLATD=YLATDP*RAD
  171. 1243 LET ULOND=ULOND*RAD
  172. 1244 LET YLOND=YLONDP*RAD
  173. 1246 IF ULATD>0 THEN LET LA$="N" ELSE LET LA$="S"
  174. 1247 IF ULOND>0 THEN LET LO$="W" ELSE LET LO$="E"
  175. 1248 LET BELEV=BELEV*RAD
  176. 1249 IF BELEV=0 THEN LET BELEV=100/DEG
  177. 1251 LET AY1=AY1+1900
  178. 1252 LET EY=EY+1900
  179. 1255 LET LON=ULOND
  180. 1256 LET LAT=ULATD
  181. 1260 IF DINC=<1.99 THEN LET DINC=15
  182. 1265 IF NEST$="" THEN LET NEST=NESTS ELSE LET NEST=VAL(NEST$)
  183. 1268 IF ANS3$><"YES" AND ANS4$><"YES" AND ANS5$><"YES" THEN LET FLAG3=0 ELSE LET FLAG3=1
  184. 1270 LET MPOS=-1 'NO CALCULATIONS DONE YET
  185. 1280 LET FLAG4=0 'NO SETTING HORIZON WINDOW TIMES CALCULATED YET
  186. 1291 LET BJUL=FNJULIAN(AY1,AM1,AD1)
  187. 1292 LET EJUL=FNJULIAN(EY,EM,ED)
  188. 1295 LET DATEJ=BJUL-14
  189. 1296 FOR I=1 TO 13
  190. 1297 LET DATEJ=DATEJ+1
  191. 1298 GOSUB 3800
  192. 1299 NEXT I
  193. 1300 LET DATEJ=BJUL
  194. 1310 '****************START OF MAIN CALCULATING LOOP**********************
  195. 1311 GOSUB 2993 'CALCULATE DAY OF THE WEEK
  196. 1312 GOSUB 3800 'CALCULATE MOON DISTANCE AND PATH LOSS
  197. 1313 IF ANS8$="YES" THEN 1314 ELSE 1320
  198. 1314 IF WKDAY=1 OR WKDAY=7 THEN 1320 ELSE 1315
  199. 1315 LET MPOS=-1
  200. 1316 LET FLAG4=0
  201. 1317 GOTO 2580
  202. 1320 GOSUB 3700
  203. 1322 LET T3=DATEJ-35735!
  204. 1323 LET A=.0657098232#*T3
  205. 1328 LET FLAG1=2 'NO CALCULATIONS DONE YET
  206. 1330 IF MPOS<1 OR EL>0 THEN 1400
  207. 1340 IF B1>RTIME THEN 1390
  208. 1350 LET B=RTIME
  209. 1360 LET FLAG2=NEST
  210. 1370 LET MPOS=0 'MOON ABOUT TO RISE-PREPARE TO RESET RTIME WHEN IT RISES
  211. 1380 GOTO 1410
  212. 1390 LET MPOS=0
  213. 1400 LET B=B1
  214. 1410 IF FLAG4=3 THEN 1411 ELSE 1420
  215. 1411 LET B=STIME
  216. 1412 LET FLAG2=NEST
  217. 1413 LET FLAG4=1 'READY TO RESET STIME WHEN MOON COMES DOWN INTO HORIZON WINDOW
  218. 1414 IF B1>STIME THEN LET B=B1
  219. 1420 LET DIF1=B-INT(B/100+.5)*100+INT(B/100+.5)*60-(E-INT(E/100+.5)*100+INT(E/100+.5)*60)
  220. 1430 IF DIF1>0 THEN 1440 ELSE 1470
  221. 1440 IF DIF1<DINC THEN 1450 ELSE 2580
  222. 1450 LET B=E
  223. 1470 LET T=(B-INT(B/100)*100)/1440+INT(B/100)/24 'FRACTION OF THE DAY
  224. 1475 LET SUNRA=SUNRAS+T*.0186625# 'ESTIMATE RIGHT ASCENSION OF THE SUN
  225. 1476 IF SUNRA>TUPI THEN LET SUNRA=SUNRA-TUPI
  226. 1480 IF FLAG1<2 THEN 1490 ELSE 1530
  227. 1490 IF FLAG2<NEST THEN 1500 ELSE 1530
  228. 1500 LET FLAG2=FLAG2+1
  229. 1505 LET EST$=" "
  230. 1510 LET GAST=GAST+.016677*DINC 'ESTIMATE GREENWICH APPARENT SIDEREAL TIME
  231. 1515 LET RA=RA+DINC*.00016      'ESTIMATE LUNAR RIGHT ASCENSION
  232. 1520 GOTO 1775
  233. 1525 '*********CALCULATION OF LATITUDE AND LONGITUDE OF THE MOON***********
  234. 1530 LET FLAG2=0
  235. 1535 LET EST$=CHR$(250) 'PRINTS OUT A DOT AFTER WINDOW FIELD FOR REAL CALCS
  236. 1540 LET T5=DATEJ-17472.5#+T
  237. 1550 LET D1=FNC(.751213#+.036601102# *T5)
  238. 1560 LET D2=FNC(.822513#+.0362916457# *T5)
  239. 1570 LET D3=FNC(.995766#+.00273777852# *T5)
  240. 1580 LET D4=FNC(.974271#+.0338631922# *T5)
  241. 1590 LET D5=FNC(.0312525#+.0367481957# *T5)
  242. 1600 LET DLON=D1+RAD*(.658*SIN(2*D4)+6.289*SIN(D2)-1.274*SIN(D2-2*D4)-.186*SIN(D3)+.214*SIN(2*D2)-.114*SIN(2*D5)-.059*SIN(2*D2-2*D4)-.057*SIN(D2+D3-2*D4))
  243. 1610 LET S=D5+RAD*(.6593*SIN(2*D4)+6.2303*SIN(D2)-1.272*SIN(D2-2*D4))
  244. 1620 LET DLAT=RAD*(5.144*SIN(S)-.146*SIN(D5-2*D4))
  245. 1630 '**************CALCULATION OF RIGHT ASCENSION AND DECLINATION**********
  246. 1640 LET DEC1=COS(DLAT)*SIN(DLON)*.397821+SIN(DLAT)*.917463
  247. 1650 LET DEC2=ABS(DEC1)
  248. 1660 LET DEC=FNATAN2(DEC1,SQR(1-DEC2*DEC2))
  249. 1670 IF ANS2$="YES" OR FLAG3=1 THEN 1680 ELSE 1690
  250. 1680 IF DEC<0 THEN 1970
  251. 1690 LET RAC=COS(DLAT)*COS(DLON)/COS(DEC)
  252. 1700 LET RAS=(COS(DLAT)*SIN(DLON)*.917463-SIN(DLAT)*.397821)/COS(DEC)
  253. 1710 LET RA=FNATAN2(RAS,RAC)
  254. 1745 '*************CALCULATION OF GREENWICH APPARENT SIDEREAL TIME***********
  255. 1750 LET GMST=6.67170278#+(A-INT(A/24)*24)+1.0027379093#*T*24 'GREENWICH MEAN SIDEREAL TIME IN HOURS
  256. 1755 LET OMEGA=(372.1133#-.0529539#*(T3+T))*RAD
  257. 1760 LET OMEGA=OMEGA-INT(SGN(OMEGA)*OMEGA/TUPI)*TUPI*SGN(OMEGA)
  258. 1765 IF ABS(OMEGA)<PI THEN LET OMEGA=OMEGA-TUPI*SGN(OMEGA)
  259. 1770 LET GAST=GMST+.00029*SIN(OMEGA) 'GREENWICH APPARENT SIDEREAL TIME IN HRS.
  260. 1775 LET GAST=GAST-INT(GAST/24)*24
  261. 1780 IF RA<0 THEN LET RA=TUPI+RA
  262. 1781 IF RA>TUPI THEN LET RA=RA-TUPI
  263. 1790 GOSUB 4000 'CALCULATE GHA AND ELEVATION
  264. 1800 IF EL<0 THEN 2090 ELSE 1840
  265. 1840 '*****************CHECK TO SEE WHAT WINDOW MOON IS IN******************
  266. 1845 LET MOONWINDOW$ = " "
  267. 1850 IF DEC<O THEN 1960
  268. 1855 ON REGION GOSUB 4200,4300,4400
  269. 1930 IF MOONWINDOW$="E" AND ANS3$="YES" THEN 2050
  270. 1940 IF MOONWINDOW$="N" AND ANS4$="YES" THEN 2050
  271. 1950 IF MOONWINDOW$="A" AND ANS5$="YES" THEN 2050
  272. 1960 IF FLAG3=0 THEN 2050 ELSE 1970
  273. 1970 IF DEC<-.1047 THEN 1315 ELSE 2530
  274. 1980 '**************CHECK FLAGS FOR MOONRISES AND SETS*********************
  275. 2050 IF MPOS=0 THEN 2060 ELSE 2140
  276. 2060 LET MPOS=1 ' MOON HAS JUST RISEN-SET RTIME
  277. 2070 LET RTIME=B
  278. 2080 GOTO 2140
  279. 2090 IF MPOS<0 THEN 2110 ELSE 2100
  280. 2100 IF MPOS=0 THEN 2530 ELSE 2130
  281. 2110 LET MPOS=0 'MOON HAS BEEN CALCULATED TO BE BELOW HORIZON-WAITING NOW TO CALCULATE FIRST RISE TIME
  282. 2120 GOTO 2530
  283. 2130 IF RTIME>B THEN 1350 ELSE 2580 'JUMP TO NEXT RISE TIME
  284. 2140 IF EL<=BELEV THEN 2160
  285. 2145 IF FLAG4=2 THEN 2151 ELSE 2146 'MOON UP BUT NOT IN DESIRED HORIZON WINDOW-CHECK TO SEE IF A SET TIME HAS BEEN DETERMINED
  286. 2146 IF MPOS=1 THEN LET FLAG4=1 'PREPARE TO SET STIME WHEN MOON COMES DOWN INTO HORIZON WINDOW
  287. 2147 GOTO 2530
  288. 2151 LET FLAG4=3 'READY TO JUMP AHEAD TO SETTING HORIZON
  289. 2153 IF STIME>B THEN 1410 ELSE 2580
  290. 2160 IF MPOS=1 AND FLAG4=1 THEN 2170 ELSE 2210
  291. 2170 LET FLAG4=2 'MOON HAS RISEN ONCE AND STIME IS BEING SET
  292. 2180 LET STIME=B 'TIME AT WHICH MOON COMES DOWN BELOW CHOSEN ELEVATION
  293. 2210 GOSUB 4100 'CALCULATE AZIMUTH OF THE MOON
  294. 2255 '*************************CHECK FOR NEW MOON**************************
  295. 2256 LET RADIF=ABS(RA-SUNRA)
  296. 2257 IF RADIF>PI THEN LET RADIF=ABS(RADIF-TUPI)
  297. 2258 IF RADIF<.1134464 THEN LET NEWMOON$="NM" ELSE LET NEWMOON$="  " 'SEE IF SUN IS WITHIN 6.5° OF MOON
  298. 2270 IF FLAG1<2 THEN 2390 ELSE 2271
  299. 2271 '*************************PRINT OUT HEADINGS************************
  300. 2280 LET NM1=INT(AM1)
  301. 2305 GOSUB 3500 'DETERMINE MONTH OF THE YEAR
  302. 2310 LPRINT CHR$(12) 'FORM FEED
  303. 2320 LPRINT MO$;:LPRINT  USING " ##_,";INT(AD1);:LPRINT USING "####";INT(AY1);:LPRINT TAB(18);:LPRINT USING "###_°";ULATDP;:LPRINT USING "##_'";ULATMP;:LPRINT USING "##";ULATSP;:LPRINT CHR$(34); " "; LA$;TAB(32);"MOON POSITION FOR ";CSIGN$;TAB(62);
  304. 2325 LPRINT TAB(62);"RANGE: ";:LPRINT USING " ###,### _K_M";RANGE
  305. 2330 LPRINT WKDAY$;TAB(18);:LPRINT USING "###_°";ULONDP;:LPRINT USING "##_'";ULONMP;:LPRINT USING "##";ULONSP;:LPRINT CHR$(34); " "; LO$ ;TAB(34);"(PRINTED BY ";YCSIGN$;")";TAB(62);GEE$;TAB(63);:LPRINT USING "_+## _D_A_Y_S";PDAYS;
  306. 2340 LPRINT USING "###.##_'_S_D";FNR(SEMIDIA,100)
  307. 2350 LPRINT "JD:";DATEJ+2397547.5#;TAB(18);"(QTH:";LOCATOR$;")"
  308. 2360 IF ANS9$="YES" THEN 2362 ELSE 2370
  309. 2362 LPRINT TAB(43);"MOON FOR ";YCSIGN$;TAB(62);"144 MHZ   432 MHZ"
  310. 2363 LPRINT "GMT";TAB(8);"NOTES";TAB(17);"W AZIMUTH";TAB(29);"ELEV";TAB(37);"DEC";TAB(43);"AZIMUTH";TAB(53);"ELEV";TAB(62);"°K   DB   °K   DB"
  311. 2365 LPRINT "====";TAB(7);"========";TAB(17);"= =======";TAB(28);"======";TAB(36);"=====";TAB(43);"=======";TAB(52);"======";TAB(61);"========= ========="
  312. 2369 GOTO 2390
  313. 2370 LPRINT TAB(62);"144 MHZ   432 MHZ"
  314. 2375 LPRINT "GMT";TAB(8);"NOTES";TAB(17);"W AZIMUTH";TAB(29);"ELEV";TAB(38);"GHA";TAB(46);"DEC";TAB(52);"RT ASCN";TAB(62);"°K   DB   °K   DB"
  315. 2380 LPRINT "====";TAB(7);"========";TAB(17);"= =======";TAB(28);"======";TAB(36);"=======";TAB(45);"=====";TAB(52);"=======";TAB(61);"========= ========="
  316. 2390 '**********************PRINT OUT DATA*******************************
  317. 2395 IF T-FLAG1<2*DINC/1440 THEN 2410
  318. 2400 LPRINT 'LINE FEED IF MOON HAS SET PREVIOUSLY
  319. 2410 LET NB=INT(B*10+.5)/10
  320. 2412 LET H$=""
  321. 2413 IF NB<1000 THEN LET H$="0"
  322. 2414 IF NB<100 THEN LET H$="00"
  323. 2415 IF NB<10 THEN LET H$="000"
  324. 2416 LET GMT$=H$+RIGHT$(STR$(NB),(LEN(STR$(NB))-1))
  325. 2460 LET RAH=RA/TUPI*24
  326. 2470 LET IRAP1=INT(RAH)
  327. 2480 LET IRAP2=INT((RAH-IRAP1)*60)
  328. 2490 GOSUB 3015 'CALCULATE SKY TEMPS AND DB INDICES
  329. 2491 IF ANS9$= "YES" THEN  2492 ELSE 2507
  330. 2492 LPRINT GMT$;TAB(7);NEWMOON$;TAB(17);MOONWINDOW$;EST$;:LPRINT USING " ###.#  ";FNA(AZ),FNA(EL);:LPRINT USING " ###.# ";FNA(DEC);
  331. 2493 LET LAT=YLATD
  332. 2494 LET LON=YLOND
  333. 2495 GOSUB 4000
  334. 2496 IF EL>= 0 THEN 2497 ELSE 2500
  335. 2497 GOSUB 4100
  336. 2498 LPRINT USING "  ###.# ";FNA(AZ),FNA(EL);
  337. 2500 LET LAT=ULATD
  338. 2501 LET LON=ULOND
  339. 2506 GOTO 2508
  340. 2507 LPRINT GMT$;TAB(7);NEWMOON$;TAB(17);MOONWINDOW$;EST$;:LPRINT USING " ###.#  ";FNA(AZ),FNA(EL);:LPRINT USING "  ###.# ";FNA(GHA),FNA(DEC);:LPRINT USING " ##_H";IRAP1;:LPRINT USING " ##_M";IRAP2;
  341. 2508 IF NEWMOON$="NM" THEN 2511 ELSE 2526
  342. 2511 LET MR=RA
  343. 2512 LET MD=DEC
  344. 2513 LET RA=SUNRA
  345. 2514 LET DEC=SUNDEC
  346. 2515 LET FLAG5=1
  347. 2516 GOSUB 4000
  348. 2517 IF EL>=0 THEN 2518 ELSE 2521
  349. 2518 GOSUB 4100
  350. 2519 LPRINT TAB(61);:LPRINT USING "####.# _A_Z";FNA(AZ);:LPRINT USING "  ###.# _E_L";FNA(EL)
  351. 2520 GOTO 2522
  352. 2521 LPRINT TAB(62);"SUN BELOW HORIZON"
  353. 2522 LET RA=MR
  354. 2523 LET DEC=MD
  355. 2524 LET FLAG5=0
  356. 2525 GOTO 2529
  357. 2526 LPRINT TAB(61);:LPRINT USING "####";KTEMPA;:LPRINT USING "###.#";FNR(DBA,10);:LPRINT USING " ###";KTEMPB;:LPRINT USING " ###.#";FNR(DBB,10)
  358. 2529 LET FLAG1=T
  359. 2530 LET B=FNR(B+DINC,1000)
  360. 2540 LET Z=B-INT(B/100)*100-60
  361. 2550 IF Z<0 THEN 1420 ELSE 2560
  362. 2560 LET B=INT(B/100)*100+100+Z
  363. 2570 GOTO 1420
  364. 2580 GOSUB 2790
  365. 2590 LET DATEJ=FNR(DATEJ,10)
  366. 2610 IF DATEJ-EJUL>.5 THEN 2620 ELSE 1310
  367. 2620 LPRINT CHR$(12)
  368. 2625 LPRINT CHR$(12)
  369. 2630 GOTO 6000
  370. 2790 '****SUBROUTINE TO INCREMENT DAY AND CORRECT DATE FOR MONTH AND YEAR****
  371. 2800 IF AD1<28 THEN 2980 ELSE 2810
  372. 2810 IF AM1=2 THEN 2820 ELSE 2860
  373. 2820 IF AY1=400*INT(AY1/400) THEN 2850 ELSE 2830
  374. 2830 IF AY1=100*INT(AY1/100) THEN 2950 ELSE 2840
  375. 2840 IF AY1=4*INT(AY1/4) THEN 2850 ELSE 2950
  376. 2850 IF AD1<29 THEN 2980 ELSE 2950
  377. 2860 IF AD1<30 THEN 2980 ELSE 2870
  378. 2870 IF AD1=30 THEN 2880 ELSE 2920
  379. 2880 IF AM1=4 THEN 2950 ELSE 2890
  380. 2890 IF AM1=6 THEN 2950 ELSE 2900
  381. 2900 IF AM1=9 THEN 2950 ELSE 2910
  382. 2910 IF AM1=11 THEN 2950 ELSE 2980
  383. 2920 IF AM1=12 THEN 2930 ELSE 2950
  384. 2930 LET AY1=INT((AY1+1)*100+.5)/100
  385. 2940 LET AM1=0
  386. 2950 LET AD1=1
  387. 2960 LET AM1=AM1+1
  388. 2970 GOTO 2990
  389. 2980 LET AD1=AD1+1
  390. 2990 LET DATEJ=DATEJ+1 ' NOW ALSO INCREASE JULIAN DATE BY ONE DAY
  391. 2991 RETURN
  392. 2992 '********************SUBROUTINE TO CALCULATE GMT DAY OF THE WEEK**********
  393. 2993 LET WKDAY=1+DATEJ-INT(DATEJ/7)*7
  394. 2994 ON WKDAY GOTO 2995,2997,2999,3001,3003,3005,3007
  395. 2995 LET WKDAY$="SUNDAY"
  396. 2996 GOTO 3008
  397. 2997 LET WKDAY$="MONDAY"
  398. 2998 GOTO 3008
  399. 2999 LET WKDAY$="TUESDAY"
  400. 3000 GOTO 3008
  401. 3001 LET WKDAY$="WEDNESDAY"
  402. 3002 GOTO 3008
  403. 3003 LET WKDAY$="THURSDAY"
  404. 3004 GOTO 3008
  405. 3005 LET WKDAY$="FRIDAY"
  406. 3006 GOTO 3008
  407. 3007 LET WKDAY$="SATURDAY"
  408. 3008 RETURN
  409. 3015 '********SUBROUTINE TO CALCULATE BACKGROUND SKY TEMPERATURE**********
  410. 3016 LET DBR=.0000451906#*((RANGE-PRANGE)*(T-.5)+RANGE)-16.3636 'DB DEGRADATION FROM MOON DISTANCE, COMPARED TO PERIGEE
  411. 3020 FOR I%=2 TO 50
  412. 3025 IF H(I%)>RAH THEN 3050
  413. 3030 NEXT I%
  414. 3050 LET KTEMPA=INT((RTEMA(I%)-RTEMA(I%-1))/.5*(RAH-H(I%-1))+RTEMA(I%-1))
  415. 3070 LET KTEMPB=INT((RTEMB(I%)-RTEMB(I%-1))/.5*(RAH-H(I%-1))+RTEMB(I%-1))
  416. 3071 LET DBA=DBR+10*FNL((TEMRA+KTEMPA)/(TEMRA+174))   '144 MHZ DB INDEX
  417. 3072 LET DBB=DBR+10*FNL((TEMRB+KTEMPB)/(TEMRB+12.45)) '432 MHZ DB INDEX
  418. 3073 RETURN
  419. 3075 RETURN
  420. 3080 '******SUBROUTINE TO CALCULATE LOCATOR FROM LAT & LON IN DEGREES******
  421. 3081 IF ULATD=90 THEN LET LOCATOR$="N POLE"
  422. 3082 IF ULATD=-90 THEN LET LOCATOR$="S POLE"
  423. 3083 IF LOCATOR$="" THEN 3084 ELSE 3100
  424. 3084 IF ULOND=-180 THEN LET ULOND=180
  425. 3085 LET ZLO=(180-ULOND)/20
  426. 3086 LET ZLA=(ULATD+90)/10
  427. 3087 LET ZA=INT(ZLO)
  428. 3088 LET ZB=INT(ZLA)
  429. 3089 LET ZLO=(ZLO-ZA)*10
  430. 3090 LET ZLA=(ZLA-ZB)*10
  431. 3091 LET ZC=INT(ZLO)
  432. 3092 LET ZD=INT(ZLA)
  433. 3095 LET LOCATOR$=CHR$(65+ZA)+CHR$(65+ZB)+CHR$(48+ZC)+CHR$(48+ZD)+CHR$(65+INT((ZLO-ZC)*24))+CHR$(65+INT((ZLA-ZD)*24))
  434. 3100 RETURN
  435. 3500 '***********SUBROUTINE TO DETERMINE MONTH OF THE YEAR******************
  436. 3511 IF NM1=1 THEN LET MO$="JAN"
  437. 3512 IF NM1=2 THEN LET MO$="FEB"
  438. 3513 IF NM1=3 THEN LET MO$="MAR"
  439. 3514 IF NM1=4 THEN LET MO$="APR"
  440. 3515 IF NM1=5 THEN LET MO$="MAY"
  441. 3516 IF NM1=6 THEN LET MO$="JUN"
  442. 3517 IF NM1=7 THEN LET MO$="JUL"
  443. 3518 IF NM1=8 THEN LET MO$="AUG"
  444. 3519 IF NM1=9 THEN LET MO$="SEP"
  445. 3520 IF NM1=10 THEN LET MO$="OCT"
  446. 3521 IF NM1=11 THEN LET MO$="NOV"
  447. 3522 IF NM1=12 THEN LET MO$="DEC"
  448. 3550 RETURN
  449. 3700 '***CALCULATION OF SUN'S RIGHT ASCENSION AND DECLINATION AT 0 HRS GMT*****
  450. 3723 LET T4=(DATEJ-17472.5)/36525!
  451. 3724 LET SUNM=FNC(.9957667#+99.997361#*T4 )
  452. 3725 SUNLON=FNC(.77691944444#+100.0021361#*T4)+FNC(.0053305556#-.00001333333#*T4)*SIN(SUNM)+3.490659E-04*SIN(2*SUNM)
  453. 3726 LET EPSILON=FNC(.0651444#-.0000361#*T4)
  454. 3730 LET SUNRA=ATN(COS(EPSILON)*TAN(SUNLON))
  455. 3731 LET LANGLE=SUNLON-INT(SUNLON/TUPI)*TUPI
  456. 3733 IF LANGLE<PI*1.5 AND LANGLE>=PI/2 THEN LET SUNRA=SUNRA+PI
  457. 3735 LET SUNRAS=SUNRA-INT(SUNRA/TUPI)*TUPI
  458. 3740 LET SUNDEC=SIN(EPSILON)*SIN(SUNLON)
  459. 3741 LET SUNDEC=FNATAN2(SUNDEC,SQR(1-SUNDEC*SUNDEC))
  460. 3745 RETURN
  461. 3800 '*****SUBROUTINE TO CALCULATE GEOCENTRIC MOON DISTANCE AT GMT NOON******
  462. 3801 LET PRANGE=RANGE
  463. 3803 LET T8=(DATEJ-53997!) 'TIME AT NOON
  464. 3804 LET F2=FNC(.374897#+.03629164709#*T8)
  465. 3805 LET F3=FNC(.259091#+.0367481952#*T8)
  466. 3806 LET F4=FNC(.827362#+.03386319198#*T8)
  467. 3808 LET F8=FNC(.993126#+.0027377785#*T8)
  468. 3810 LET RANGE=60.36298-3.27746*COS(F2)-.57994*COS(F2-2*F4)-.46357*COS(2*F4)-8.904001E-02*COS(2*F2)+.03865*COS(2*F2-2*F4)-.03237*COS(2*F4-F8)-.02688*COS(F2-2*F4)-.02358*COS(F2-2*F4+F8)-.0203*COS(F2-F8)+.01719*COS(F4)+.01671*COS(F2+F8)
  469. 3815 LET RANGE1=.01247*COS(F2-2*F3)+.00704*COS(F8)+.00529*COS(2*F4+F8)-.00524*COS(F2-4*F4)+.00398*COS(F2-2*F4-F8)-.00366*COS(3*F2)-.00295*COS(2*F2-4*F4)-.00263*COS(F4+F8)+.00249*COS(3*F2-2*F4)-.00221*COS(F2+2*F4-F8)+.00185*COS(2*F3-2*F4)
  470. 3816 LET RANGE2=-.00161*COS(2*F4-2*F8)+.00147*COS(F2+2*F3-2*F4)-.00142*COS(4*F4)+.00139*COS(2*F2-2*F4+F8)-.00118*COS(F2-4*F4+F8)-.00116*COS(2*F2+2*F4)-.0011*COS(2*F2-F8)
  471. 3817 LET RANGE=RANGE+RANGE1+RANGE2
  472. 3820 LET SEMIDIA=936.74867#/RANGE 'GEOCENTRIC SEMIDIAMETER IN MINUTES OF ARC
  473. 3825 LET RANGE=RANGE*6378.16 'CHANGE DISTANCE FROM EQUATORIAL EARTH RADII TO KM
  474. 3840 IF PRANGE>RANGE THEN 3860
  475. 3842 'MOON GETTING FARTHER FROM EARTH
  476. 3843 IF GEE$<>"P" THEN 3846 ELSE 3870
  477. 3846 LET GEE$="P"
  478. 3848 GOTO 3866
  479. 3860 'MOON GETTING CLOSER TO EARTH
  480. 3862 IF GEE$<>"A" THEN 3864 ELSE 3870
  481. 3864 LET GEE$="A"
  482. 3866 LET PDAYS=0
  483. 3870 LET PDAYS=PDAYS+1
  484. 3900 RETURN
  485. 4000 '******************SUBROUTINE TO CALCULATE ELEVATION*********************
  486. 4002 LET GHA=GAST*.2617994-RA
  487. 4004 IF GHA<0 THEN 4005 ELSE 4006
  488. 4005 LET GHA=GHA+TUPI
  489. 4006 IF GHA>TUPI THEN LET GHA=GHA-TUPI
  490. 4013 LET UHA= LON -GHA
  491. 4014 LET ELSIN=COS( LAT )*COS(UHA)*COS(DEC)+SIN(DEC)*SIN( LAT )
  492. 4015 LET ELCOS=SQR(1-ELSIN*ELSIN)
  493. 4016 LET EL=FNATAN2(ELSIN,ELCOS) 'UNCORRECTED ELEVATION
  494. 4017 IF FLAG5=1 THEN 4025
  495. 4018 LET ELCORS=6378.16*COS(EL)
  496. 4019 LET ELCORC=RANGE-6378.16*SIN(EL)
  497. 4020 LET ELCORD=FNATAN2(ELCORS,ELCORC) 'CORRECTION FACTOR DUE TO EARTH DIAMETER
  498. 4021 LET EL=EL-ELCORD
  499. 4025 LET FEL=EL
  500. 4029 IF EL<0 OR  EL>.27925 THEN 4050 'SKIP ATMOS CORRECTION
  501. 4030 LET ZD=PI/2-EL
  502. 4032 LET SINREF=.9986047*SIN(.9967614*ZD)
  503. 4034 LET SINREF=FNATAN2(SINREF,SQR(1-SINREF*SINREF))
  504. 4035 LET ELCORA=1.04329E-03*(196.5411*(ZD-SINREF)-.6393802*ZD) 'VISIBLE ATMOSPHERIC REFRACTION CORRECTION FACTOR AT 50°F AND 1015 MB PRESSURE
  505. 4040 LET EL=EL-ELCORA
  506. 4050 RETURN
  507. 4100 '******************SUBROUTINE TO CALCULATE AZIMUTH***********************
  508. 4110 LET AZCOS=SIN(DEC)/(COS(LAT)*COS(FEL))-SIN(LAT)/COS(LAT)*(SIN(FEL)/COS(FEL))
  509. 4120 LET AZSIN=SIN(LAT)*SIN(DEC)+COS(LAT)*COS(DEC)*COS(UHA)
  510. 4130 LET AZSIN=SIN(UHA)*COS(DEC)/SQR(1-AZSIN*AZSIN)
  511. 4140 LET AZ=FNATAN2(AZSIN,AZCOS)
  512. 4150 IF AZ<=0 THEN LET AZ=AZ+TUPI
  513. 4160 RETURN
  514. 4200 '******SUBROUTINE TO DETERMINE MOON WINDOW FOR IARU REGION 1 STATIONS*****
  515. 4205 IF GHA<PI THEN 4245
  516. 4210 'CHECK TO SEE IF IN ASIAN WINDOW (2 HOURS FOLLOWING FRANKFURT MOONRISE)
  517. 4220 IF DEC=>-.74545*GHA+3.421194 AND DEC=<-.74545*GHA+3.799083 THEN LET MOONWINDOW$="A"
  518. 4230 'CHECK TO SEE IF MOON IS IN EUROPEAN WINDOW
  519. 4240 IF DEC=>-.74545*GHA+3.799083 THEN LET MOONWINDOW$="E"
  520. 4244 GOTO 4290
  521. 4245 IF DEC=>.8075099*GHA-.7186963 THEN LET MOONWINDOW$="E"
  522. 4250 'CHECK TO SEE IF MOON IS IN NORTH AMERICAN WINDOW
  523. 4260 IF DEC=<.80751*GHA-.718696 AND DEC=>.80751*GHA-1.128051 THEN LET MOONWINDOW$="N"
  524. 4290 RETURN
  525. 4300 '******SUBROUTINE TO DETERMINE MOON WINDOW FOR IARU REGION 2 STATIONS*****
  526. 4310 '  CHECK TO SEE IF IN EUROPEAN WINDOW
  527. 4320 IF DEC<=.80751*GHA-.7186963 AND DEC>=.80751*GHA-1.128051 THEN LET MOONWINDOW$="E"
  528. 4330 '  CHECK TO SEE IF IN NORTH AMERICAN WINDOW
  529. 4340 IF DEC<=.80751*GHA-1.128051 AND DEC<=-1.3572416#*GHA+3.350332 THEN LET MOONWINDOW$="N"
  530. 4350 '  CHECK TO SEE IF IN ASIAN WINDOW
  531. 4360 IF DEC>=-1.357242*GHA+3.350332 AND DEC<=-1.357242*GHA+4.038211 THEN LET MOONWINDOW$="A"
  532. 4390 RETURN
  533. 4400 '******SUBROUTINE TO DETERMINE MOON WINDOW FOR IARU REGION 3 STATIONS*****
  534. 4410 'CHECK TO SEE IF IN NORTH AMERICAN WINDOW
  535. 4420 IF DEC=>-1.357242*GHA+3.350332 AND DEC=<-1.357242*GHA+4.038211 THEN LET MOONWINDOW$="N"
  536. 4430 'CHECK TO SEE IF IN ASIAN WINDOW
  537. 4440 IF DEC=>-1.357242*GHA+4.038211 AND DEC=<-.74545*GHA+3.421194 THEN LET MOONWINDOW$="A"
  538. 4450 'CHECK TO SEE IF IN EUROPEAN WINDOW
  539. 4460 IF DEC=>-.74545*GHA+3.421194 AND DEC=<-.74545*GHA+3.799083 THEN LET MOONWINDOW$="E"
  540. 4490 RETURN
  541. 6000 END
  542.